perm filename FORMAT.IO[LSP,LSP] blob sn#210790 filedate 1976-04-11 generic text, type T, neo UTF8
(DFUNC (FORMANEXPR ANEXPR)
 (PROG (PLATE)
       (SETQ PLATE (COND ((OR (ATOM ANEXPR)
			      (NOT (EQ (CAR ANEXPR) (Q LAP))))
			  (COMPOSEXPR ANEXPR (LINELENGTH NIL) 0 0))
			 (T (COMPOSLAP (READLAP ANEXPR)
				       (LINELENGTH NIL)
				       0
				       0))))
       (COND ((GREATERP	(ADD1 (HEIGHT PLATE))
			(DIFFERENCE PAGEHEIGHT (SUB1 LINCNT)))
	      (COND ((NOT (EQ LINCNT 1)) (FORMF)))))
       (PRINTIT (TEXT PLATE) 0)
       (COND ((NOT (ATLEFT)) (LINEF 2)))
       (RETURN NIL)))

(DEFPROP FORMAT
 (LAMBDA (L)
  (PROG (DEV)
	(SETQ DEV (Q DSK:))
   LOOP	(COND ((NULL L) (RETURN NIL)))
	(COND ((%DEVP (CAR L)) (SETQ DEV (CAR L)) (SETQ L (CDR L))))
	(FORMFILE (LIST DEV (CAR L))
		  (LIST	(Q DSK:)
			(CONS (COND ((ATOM (CAR L)) (CAR L))
				    (T (CAAR L)))
			      OUTEXT)))
	(SETQ L (CDR L))
	(GO LOOP)))
 FEXPR)

(DFUNC (FORMFILE INFILE OUTFILE)
       (PROG (LINCNT)
	     (INC (EVAL (MCONS (Q INPUT) (GENSYM) INFILE)))
	     (OUTC (EVAL (MCONS (Q OUTPUT) (GENSYM) OUTFILE)))
	     (FLUSHCOMMENT)
	     (LINELENGTH PAGEWIDTH)
	     (SETQ LINCNT 1)
	     (FORMREADS)
	     (INC NIL T)
	     (OUTC NIL T)
	     (RETURN NIL)))

(DFUNC (FORMREADS) (READLOOP (FUNCTION FORMANEXPR)))

(DFUNC (READLOOP ACTFUNC)
       (PROG (EXPR)
	LOOP (SETQ EXPR (ERRSET (READ)))
	     (COND ((EQ EXPR (Q $EOF$)) (RETURN NIL)))
	     (ACTFUNC (CAR EXPR))
	     (GO LOOP)))

(DFUNC (FORMREAD EXPR)
       (PROG (FORM)
	     (COND ((ATOM EXPR) (RETURN (FORMATOM EXPR))))
	     (SETQ FORM (GETGET (CAR EXPR) (Q TOPFORM)))
	     (COND (FORM (RETURN ((PROPVAL FORM) EXPR))))
	     (RETURN (FORMEXPR EXPR))))

(DFUNC (FORMATOM EXPR)
       (PROGN (PRINTPLATE (SETEXPR EXPR (CLEANPLATE)) 0)
	      (COND ((NOT (ATTOP)) (FORMF)))
	      (COND ((NOT (ATLEFT)) (LINEF 2)))))
(DFUNC (FORMEXPR EXPR)
       (PROGN (PRINTPLATE (COMPOSEXPR EXPR (LINELENGTH NIL) 0 0) 0)
	      (COND ((NOT (ATTOP)) (FORMF)))
	      (COND ((NOT (ATLEFT)) (LINEF 2)))

(DFUNC (FORMLAP EXPR) (PROGN))

(SETQ OUTEXT (Q FMT))